home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / fastpix / fastpixe.cls < prev    next >
Text File  |  1999-09-14  |  4KB  |  134 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "FastPixels"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Private Type SAFEARRAYBOUND
  15.     cElements As Long
  16.     lLbound As Long
  17. End Type
  18.  
  19. Private Type SAFEARRAY1D
  20.     cDims As Integer
  21.     fFeatures As Integer
  22.     cbElements As Long
  23.     cLocks As Long
  24.     pvData As Long
  25.     Bounds(0 To 0) As SAFEARRAYBOUND
  26. End Type
  27.  
  28. Private Type SAFEARRAY2D
  29.     cDims As Integer
  30.     fFeatures As Integer
  31.     cbElements As Long
  32.     cLocks As Long
  33.     pvData As Long
  34.     Bounds(0 To 1) As SAFEARRAYBOUND
  35. End Type
  36.  
  37. Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long
  38. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
  39. Private Type BITMAP
  40.     bmType As Long
  41.     bmWidth As Long
  42.     bmHeight As Long
  43.     bmWidthBytes As Long
  44.     bmPlanes As Integer
  45.     bmBitsPixel As Integer
  46.     bmBits As Long
  47. End Type
  48.  
  49. Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
  50.  
  51.  
  52. Public Function DoBlur8(PictBox As PictureBox, PBar As ProgressBar) As Byte()
  53.     Dim pict() As Byte
  54.     Dim sa As SAFEARRAY2D, bmp As BITMAP
  55.     Dim r As Integer, c As Integer, value As Byte
  56.  
  57.     GetObjectAPI PictBox.Picture, Len(bmp), bmp
  58.  
  59.     If bmp.bmPlanes <> 1 Or bmp.bmBitsPixel <> 8 Then
  60.         MsgBox " 256-color bitmaps only", vbCritical
  61.         Exit Function
  62.     End If
  63.    
  64.     With sa
  65.         .cbElements = 1
  66.         .cDims = 2
  67.         .Bounds(0).lLbound = 0
  68.         .Bounds(0).cElements = bmp.bmHeight
  69.         .Bounds(1).lLbound = 0
  70.         .Bounds(1).cElements = bmp.bmWidthBytes
  71.         .pvData = bmp.bmBits
  72.     End With
  73.     CopyMemory ByVal VarPtrArray(pict), VarPtr(sa), 4
  74.     
  75.     PBar.Max = UBound(pict, 1) - 1
  76.     
  77.     ' Loop through every pixel
  78.     For x = 1 To UBound(pict, 1) - 1
  79.         For y = 1 To UBound(pict, 2) - 1
  80.             ' Do calculation on pixel
  81.             i1 = pict(x - 1, y)
  82.             i2 = pict(x + 1, y)
  83.             i3 = pict(x, y - 1)
  84.             i4 = pict(x, y + 1)
  85.             i5 = pict(x - 1, y + 1)
  86.             i6 = pict(x + 1, y + 1)
  87.             i7 = pict(x - 1, y - 1)
  88.             i8 = pict(x + 1, y - 1)
  89.             pict(x, y) = (i1 + i2 + i3 + i4 + i5 + i6 + i7 + i8) / 8
  90.             PBar.value = x
  91.         Next
  92.     Next
  93.     
  94.     CopyMemory ByVal VarPtrArray(pict), 0&, 4
  95.     PictBox.Refresh
  96. End Function
  97.  
  98. Public Function AddNoise8(Amount As Long, PictBox As PictureBox, PBar As ProgressBar) As Byte()
  99.     Dim pict() As Byte
  100.     Dim sa As SAFEARRAY2D, bmp As BITMAP
  101.     Dim r As Integer, c As Integer, value As Byte
  102.  
  103.     GetObjectAPI PictBox.Picture, Len(bmp), bmp
  104.  
  105.     If bmp.bmPlanes <> 1 Or bmp.bmBitsPixel <> 8 Then
  106.         MsgBox " 256-color bitmaps only", vbCritical
  107.         Exit Function
  108.     End If
  109.    
  110.     With sa
  111.         .cbElements = 1
  112.         .cDims = 2
  113.         .Bounds(0).lLbound = 0
  114.         .Bounds(0).cElements = bmp.bmHeight
  115.         .Bounds(1).lLbound = 0
  116.         .Bounds(1).cElements = bmp.bmWidthBytes
  117.         .pvData = bmp.bmBits
  118.     End With
  119.     CopyMemory ByVal VarPtrArray(pict), VarPtr(sa), 4
  120.     
  121.     PBar.Max = Amount
  122.     
  123.     For i = 0 To Amount
  124.         y = Int(Rnd * UBound(pict, 2))
  125.         x = Int(Rnd * UBound(pict, 1))
  126.         c = Int(Rnd * 255)
  127.         pict(x, y) = c
  128.         PBar.value = i
  129.     Next
  130.     
  131.     CopyMemory ByVal VarPtrArray(pict), 0&, 4
  132.     PictBox.Refresh
  133. End Function
  134.